home *** CD-ROM | disk | FTP | other *** search
/ Personal Computer World 2005 October / PCWOCT05.iso / Software / Resources / CutePDF 2.3 / converter.exe / GNUGS / GS_FONTS.PS < prev    next >
Text File  |  2002-04-03  |  34KB  |  1,041 lines

  1. %    Copyright (C) 1990, 2000 Aladdin Enterprises.  All rights reserved.
  2. % This software is provided AS-IS with no warranty, either express or
  3. % implied.
  4. % This software is distributed under license and may not be copied,
  5. % modified or distributed except as expressly authorized under the terms
  6. % of the license contained in the file LICENSE in this distribution.
  7. % For more information about licensing, please refer to
  8. % http://www.ghostscript.com/licensing/. For information on
  9. % commercial licensing, go to http://www.artifex.com/licensing/ or
  10. % contact Artifex Software, Inc., 101 Lucas Valley Road #110,
  11. % San Rafael, CA  94903, U.S.A., +1(415)492-9861.
  12.  
  13. % $Id: gs_fonts.ps,v 1.13.2.3 2002/04/02 13:57:27 mpsuzuki Exp $
  14. % Font initialization and management code.
  15.  
  16. % Define the default font.
  17. /defaultfontname /Courier def
  18.  
  19. % Define the name of the font map file.
  20. /defaultfontmap (Fontmap) def
  21.  
  22. % ------ End of editable parameters ------ %
  23.  
  24. % Define the UniqueIDs and organization XUID assigned to Aladdin.
  25. % UniqueIDs 5,066,501 - 5,066,580 are assigned as follows:
  26. %   01 and 02 for shareware Cyrillic
  27. %   33 through 67 for Type 1 versions of the Hershey fonts
  28. % UniqueIDs 5,115,501 - 5,115,600 are currently unassigned.
  29. /AladdinEnterprisesXUID 107 def
  30.  
  31. % If SUBSTFONT is defined, make it the default font.
  32. /SUBSTFONT where { pop /defaultfontname /SUBSTFONT load def } if
  33.  
  34. % Define a reliable way of accessing FontDirectory in systemdict.
  35. /.FontDirectory
  36. { /FontDirectory .systemvar
  37. } .bind odef
  38.  
  39. % If DISKFONTS is true, we load individual CharStrings as they are needed.
  40. % (This is intended primarily for machines with very small memories.)
  41. % In this case, we define another dictionary, parallel to FontDirectory,
  42. % that retains an open file for every font loaded.
  43. /FontFileDirectory 10 dict def
  44.  
  45. % Define a temporary string for local use, since using =string
  46. % interferes with some PostScript programs.
  47. /.fonttempstring 128 string def
  48.  
  49. % Split up a search path into individual directories or files.
  50. /.pathlist        % <path> .pathlist <dir1|file1> ...
  51.  {  { dup length 0 eq { pop exit } if
  52.       .filenamelistseparator search not { exit } if
  53.       exch pop exch
  54.     }
  55.    loop
  56.  } bind def
  57.  
  58. % Load a font name -> font file name map.
  59. userdict /Fontmap .FontDirectory maxlength dict put
  60. /.loadFontmap {        % <file> .loadFontmap -
  61.         % We would like to simply execute .definefontmap as we read,
  62.         % but we have to maintain backward compatibility with an older
  63.         % specification that makes later entries override earlier
  64.         % ones within the same file.
  65.    50 dict exch .readFontmap
  66.     { .definefontmap } forall
  67. } bind def
  68. /.readFontmap {        % <dict> <file> .readFontmap <dict>
  69.     { dup token not { closefile exit } if
  70.         % stack: dict file fontname
  71.       % This is a hack to get around the absurd habit of MS-DOS editors
  72.       % of adding an EOF character at the end of the file.
  73.       dup (\032) eq { pop closefile exit } if
  74.       1 index token not
  75.        { (Fontmap entry for ) print dup =only
  76.      ( has no associated file or alias name!  Giving up.) = flush
  77.      {.readFontmap} 0 get 1 .quit
  78.        } if
  79.       dup type dup /stringtype eq exch /nametype eq or not
  80.        { (Fontmap entry for ) print 1 index =only
  81.      ( has an invalid file or alias name!  Giving up.) = flush
  82.      {.readFontmap} 0 get 1 .quit
  83.        } if
  84.         % stack: dict file fontname filename|aliasname
  85.       1 index type /stringtype eq
  86.       1 index type /nametype eq and 1 index xcheck and
  87.       1 index /run eq 2 index /.runlibfile eq or and {
  88.         % This is an inclusion entry.
  89.     pop findlibfile { exch pop } { file } ifelse
  90.     2 index exch .readFontmap pop
  91.       } {
  92.         % This is a real entry.
  93.         % Read and pop tokens until a semicolon.
  94.        { 2 index token not
  95.       { (Fontmap entry for ) print 1 index =only
  96.         ( ends prematurely!  Giving up.) = flush
  97.         {.loadFontmap} 0 get 1 .quit
  98.       } if
  99.      dup /; eq { pop 3 index 3 1 roll .growput exit } if
  100.      pop
  101.        } loop
  102.       } ifelse
  103.     } loop
  104. } bind def
  105. % Add an entry in Fontmap.  We redefine this if the Level 2
  106. % resource machinery is loaded.
  107. /.definefontmap            % <fontname> <file|alias> .definefontmap -
  108.  {        % Since Fontmap is global, make sure the values are storable.
  109.    .currentglobal 3 1 roll true .setglobal
  110.    dup type /stringtype eq
  111.     { dup .gcheck not { dup length string copy } if
  112.     }
  113.    if
  114.    Fontmap 3 -1 roll 2 copy .knownget
  115.     {        % Add an element to the end of the existing value,
  116.         % unless it's the same as the current last element.
  117.       mark exch aload pop counttomark 4 add -1 roll
  118.       2 copy eq { cleartomark pop pop } { ] readonly .growput } ifelse
  119.     }
  120.     {        % Make a new entry.
  121.       mark 4 -1 roll ] readonly .growput
  122.     }
  123.    ifelse .setglobal
  124.  } bind def
  125.  
  126. % Parse a font file just enough to find the FontName or FontType.
  127. /.findfontvalue {    % <file> <key> .findfontvalue <value> true
  128.             % <file> <key> .findfontvalue false
  129.             % Closes the file in either case.
  130.   exch dup read not { -1 } if
  131.   2 copy unread 16#80 eq {
  132.     dup (xxxxxx) readstring pop pop        % skip .PFB header
  133.   } if
  134.   {        % Stack: key file
  135.         % Protect ourselves against syntax errors here.
  136.     dup { token } stopped { pop false exit } if
  137.     not { false exit } if        % end of file
  138.     dup /eexec eq { pop false exit } if        % reached eexec section
  139.     dup /Subrs eq { pop false exit } if        % Subrs without eexec
  140.     dup /CharStrings eq { pop false exit } if    % CharStrings without eexec
  141.     dup 3 index eq
  142.      { xcheck not { dup token exit } if }    % found key
  143.      { pop }
  144.     ifelse
  145.   } loop
  146.         % Stack: key file value true   (or)
  147.         % Stack: key file false
  148.   dup { 4 } { 3 } ifelse -2 roll closefile pop
  149. } bind def
  150. /.findfontname
  151.  { /FontName .findfontvalue
  152.  } bind def
  153.  
  154. % If there is no FONTPATH, try to get one from the environment.
  155. NOFONTPATH { /FONTPATH () def } if
  156. /FONTPATH where
  157.  { pop }
  158.  { /FONTPATH (GS_FONTPATH) getenv not { () } if def }
  159. ifelse
  160. FONTPATH length 0 eq { (%END FONTPATH) .skipeof } if
  161. /FONTPATH [ FONTPATH .pathlist ] def
  162.  
  163. % Scan directories looking for plausible fonts.  "Plausible" means that
  164. % the file begins with %!PS-AdobeFont or %!FontType1, or with \200\001
  165. % followed by four arbitrary bytes and then either of these strings.
  166. % To speed up the search, we skip any file whose name appears in
  167. % the Fontmap (with any extension and upper/lower case variation) already,
  168. % and any file whose extension definitely indicates it is not a font.
  169. %
  170. % NOTE: The current implementation of this procedure is somewhat Unix/DOS-
  171. % specific.  It assumes that '/' and '\' are directory separators, and that
  172. % the part of a file name following the last '.' is the extension.
  173. %
  174. /.lowerstring        % <string> .lowerstring <lowerstring>
  175.  { 0 1 2 index length 1 sub
  176.     { 2 copy get dup 65 ge exch 90 le and
  177.        { 2 copy 2 copy get 32 add put }
  178.      if pop
  179.     }
  180.    for
  181.  } bind def
  182. /.splitfilename {    % <dir.../base.extn> .basename <base> <extn>
  183.         % Make the file name read-only to detect aliasing bugs.
  184.         % We really don't like doing this, but we've had one
  185.         % such bug already.
  186.   readonly {
  187.     (/) search { true } { (\\) search } ifelse { pop pop } { exit } ifelse
  188.   } loop
  189.   dup { (.) search { pop pop } { exit } ifelse } loop
  190.   2 copy eq {
  191.     pop ()
  192.   } {
  193.     exch dup length 2 index length 1 add sub 0 exch getinterval exch
  194.   } ifelse
  195. } bind def
  196. /.scanfontdict 1 dict def        % establish a binding
  197. /.scanfontbegin
  198.  {    % Construct the table of all file names already in Fontmap.
  199.    currentglobal true setglobal
  200.    .scanfontdict dup maxlength Fontmap length 2 add .max .setmaxlength
  201.    Fontmap
  202.     { exch pop
  203.        { dup type /stringtype eq
  204.       { .splitfilename pop .fonttempstring copy .lowerstring cvn
  205.         .scanfontdict exch true put
  206.       }
  207.       { pop
  208.       }
  209.      ifelse
  210.        }
  211.       forall
  212.     }
  213.    forall
  214.    setglobal
  215.  } bind def
  216. /.scanfontskip mark
  217.         % Strings are converted to names anyway, so....
  218.   /afm true
  219.   /bat true
  220.   /c true
  221.   /cmd true
  222.   /com true
  223.   /dir true
  224.   /dll true
  225.   /doc true
  226.   /drv true
  227.   /exe true
  228.   /fon true
  229.   /fot true
  230.   /h true
  231.   /o true
  232.   /obj true
  233.   /pfm true
  234.   /pss true        % Adobe Multiple Master font instances
  235.   /txt true
  236. .dicttomark def
  237. /.scan1fontstring 128 string def
  238. % %%BeginFont: is not per Adobe documentation, but a few fonts have it.
  239. /.scanfontheaders [(%!PS-Adobe*) (%!FontType*) (%%BeginFont:*)] def
  240. 0 .scanfontheaders { length .max } forall 6 add    % extra for PFB header
  241. /.scan1fontfirst exch string def
  242. /.scanfontdir        % <dirname> .scanfontdir -
  243.  { currentglobal exch true setglobal
  244.    QUIET not { (Scanning ) print dup print ( for fonts...) print flush } if
  245.    (*) 1 index .filenamedirseparator
  246.    dup (\\) eq { pop (\\\\) } if    % double \ for pattern match
  247.    exch concatstrings concatstrings
  248.    0 0 0 4 -1 roll    % found scanned files
  249.     {        % stack: <fontcount> <scancount> <filecount> <filename>
  250.       exch 1 add exch                   % increment filecount
  251.       dup .splitfilename .fonttempstring copy .lowerstring
  252.         % stack: <fontcount> <scancount> <filecount+1> <filename>
  253.         %    <BASE> <ext>
  254.       .scanfontskip exch known exch .scanfontdict exch known or
  255.        { pop
  256.         % stack: <fontcount> <scancount> <filecount+1>
  257.        }
  258.        { 3 -1 roll 1 add 3 1 roll
  259.         % stack: <fontcount> <scancount+1> <filecount+1> <filename>
  260.      dup (r) { file } .internalstopped
  261.       { pop pop null ()
  262.         % stack: <fontcount> <scancount+1> <filecount+1> <filename>
  263.         %    null ()
  264.       }
  265.       {
  266.         % On some platforms, the file operator will open directories,
  267.         % but an error will occur if we try to read from one.
  268.         % Handle this possibility here.
  269.         dup .scan1fontfirst { readstring } .internalstopped
  270.          { pop pop () }
  271.          { pop }
  272.         ifelse
  273.         % stack: <fontcount> <scancount+1> <filecount+1>
  274.         %    <filename> <file> <header>
  275.       }
  276.      ifelse
  277.         % Check for PFB file header.
  278.      dup (\200\001????*) .stringmatch
  279.       { dup length 6 sub 6 exch getinterval }
  280.      if
  281.         % Check for font file headers.
  282.      false .scanfontheaders
  283.       { 2 index exch .stringmatch or
  284.       }
  285.      forall exch pop
  286.       {    % stack: <fontcount> <scancount+1> <filecount+1> <filename>
  287.         %    <file>
  288.         dup 0 setfileposition .findfontname
  289.          { dup Fontmap exch known
  290.         { pop pop
  291.         }
  292.         { exch copystring exch
  293.           DEBUG { ( ) print dup =only flush } if
  294.           1 index .definefontmap
  295.           .splitfilename pop true .scanfontdict 3 1 roll .growput
  296.             % Increment fontcount.
  297.           3 -1 roll 1 add 3 1 roll
  298.         }
  299.            ifelse
  300.          }
  301.          { pop
  302.          }
  303.         ifelse
  304.       }
  305.         % .findfontname will have done a closefile in the above case.
  306.       { dup null eq { pop } { closefile } ifelse pop
  307.       }
  308.      ifelse
  309.        }
  310.       ifelse
  311.     }
  312.    .scan1fontstring filenameforall
  313.    QUIET
  314.     { pop pop pop }
  315.     { ( ) print =only ( files, ) print =only ( scanned, ) print
  316.       =only ( new fonts.) = flush
  317.     }
  318.    ifelse
  319.    setglobal
  320.  } bind def
  321.  
  322. %END FONTPATH
  323.  
  324. % Create the dictionary that registers the .buildfont procedure (called by
  325. % definefont) for each FontType.
  326. /buildfontdict 20 dict def
  327.  
  328. % Register Type 3 fonts, which are always supported, for definefont.
  329. buildfontdict 3 /.buildfont3 cvx put
  330.  
  331. % Register Type 0 fonts if they are supported.  Strictly speaking,
  332. % we should do this in its own file (gs_type0.ps), but since this is
  333. % the only thing that would be in that file, it's simpler to put it here.
  334. /.buildfont0 where { pop buildfontdict 0 /.buildfont0 cvx put } if
  335.  
  336. % Define definefont.  This is a procedure built on a set of operators
  337. % that do all the error checking and key insertion.
  338. /.growfontdict
  339.  {    % Grow the font dictionary, if necessary, to ensure room for an
  340.     % added entry, making sure there is at least one slot left for FID.
  341.    dup maxlength 1 index length sub 2 lt
  342.     { dup dup wcheck
  343.        { .growdict }
  344.        { .growdictlength dict .copydict }
  345.       ifelse
  346.     }
  347.     { dup wcheck not { dup maxlength dict .copydict } if
  348.     }
  349.    ifelse
  350.  } bind def 
  351. /.completefont {
  352.   {        % Check for disabled platform fonts.
  353.       NOPLATFONTS
  354.        {    % Make sure we leave room for FID.
  355.      .growfontdict dup /ExactSize 0 put
  356.        }
  357.        {    % Hack: if the Encoding looks like it might be the
  358.         % Symbol or Dingbats encoding, load those now (for the
  359.         % benefit of platform font matching) just in case
  360.         % the font didn't actually reference them.
  361.         % Note that some types of font don't have an Encoding.
  362.      dup /Encoding .knownget {
  363.        dup length 65 ge {
  364.          64 get
  365.          dup /congruent eq { SymbolEncoding pop } if
  366.          /a9 eq { DingbatsEncoding pop } if
  367.        } {
  368.          pop
  369.        } ifelse
  370.      } if
  371.        }
  372.       ifelse
  373.       true exch
  374.         % If this is a CIDFont, CIDFontType takes precedence
  375.         % over FontType.
  376.       dup /CIDFontType known {
  377.     /.buildcidfont where {
  378.       pop exch not exch    % true => false
  379.     } if
  380.       } if
  381.       exch {
  382.     dup /FontType get //buildfontdict exch get exec
  383.       } {
  384.     .buildcidfont
  385.       } ifelse
  386.  
  387.       DISKFONTS
  388.        { FontFileDirectory 2 index known
  389.       { dup /FontFile FontFileDirectory 4 index get .growput
  390.       }
  391.      if
  392.        }
  393.       if
  394.       readonly        % stack: name fontdict
  395.   } stopped { /invalidfont signalerror } if
  396. } bind odef
  397. /definefont
  398.  { .completefont
  399.         % If the current allocation mode is global, also enter
  400.         % the font in LocalFontDirectory.
  401.    .currentglobal
  402.     { //systemdict /LocalFontDirectory .knownget
  403.        { 2 index 2 index .growput }
  404.       if
  405.     }
  406.    if
  407.    dup .FontDirectory 4 -2 roll .growput
  408.         % If the font originated as a resource, register it.
  409.    currentfile .currentresourcefile eq { dup .registerfont } if
  410.  } odef
  411.  
  412. % Define a procedure for defining aliased fonts.
  413. % We use this only for explicitly aliased fonts, not substituted fonts:
  414. % we think this matches the observed behavior of Adobe interpreters.
  415. /.aliasfont        % <name> <font> .aliasfont <newFont>
  416.  { .currentglobal 3 1 roll dup .gcheck .setglobal
  417.    dup length 2 add dict
  418.    dup 3 -1 roll { 1 index /FID eq { pop pop } { put dup } ifelse } forall
  419.         % Stack: global fontname newfont newfont.
  420.         % We might be defining a global font whose FontName
  421.         % is a local string.  This is weird, but legal,
  422.         % and doesn't cause problems anywhere else:
  423.         % to avoid any possible problems in this case, do a cvn.
  424.         % We might also be defining (as an alias) a global font
  425.         % whose FontName is a local non-string, if someone passed a
  426.         % garbage value to findfont.  In this case, just don't
  427.         % call definefont at all.
  428.    2 index dup type /stringtype eq exch .gcheck or 1 index .gcheck not or
  429.     { /FontName 3 index dup type /stringtype eq { cvn } if put
  430.         % Don't bind in definefont, since Level 2 redefines it.
  431.       /definefont .systemvar exec
  432.     }
  433.     { .completefont pop exch pop
  434.     }
  435.    ifelse exch .setglobal
  436.  } odef        % so findfont will bind it
  437.  
  438. % Define .loadfontfile for loading a font.  If we recognize Type 1 and/or
  439. % TrueType fonts, gs_type1.ps and/or gs_ttf.ps will redefine this.
  440. /.loadfontfile {
  441.         % According to Ed Taft, Adobe interpreters push userdict
  442.         % before loading a font, and pop it afterwards.
  443.   userdict begin
  444.     cvx exec
  445.   end
  446. } bind def
  447. /.loadfont
  448.  {        % Some buggy fonts leave extra junk on the stack,
  449.         % so we have to make a closure that records the stack depth
  450.         % in a fail-safe way.
  451.    {{.loadfontfile} .execasresource} count 1 sub 2 .execn
  452.    count exch sub { pop } repeat
  453.  } bind def
  454.  
  455. % Find an alternate font to substitute for an unknown one.
  456. % We go to some trouble to parse the font name and extract
  457. % properties from it.  Later entries take priority over earlier.
  458. /.substitutefaces [
  459.     % Guess at suitable substitutions for random unknown fonts.
  460.   [(Book) /NewCenturySchlbk 0]
  461.   [(Grot) /Helvetica 0]
  462.   [(Roman) /Times 0]
  463.   [(Chancery) /ZapfChancery-MediumItalic 0]
  464.     % If the family name appears in the font name,
  465.     % use a font from that family.
  466.   [(Arial) /Helvetica 0]
  467.   [(Avant) /AvantGarde 0]
  468.   [(Bookman) /Bookman 0]
  469.   [(Century) /NewCenturySchlbk 0]
  470.   [(Cour) /Courier 0]
  471.   [(Frut) /Helvetica 0]
  472.   [(Garamond) /Palatino 0]
  473.   [(Geneva) /Helvetica 0]
  474.   [(Helv) /Helvetica 0]
  475.   [(NewYork) /Bookman 0]
  476.   [(Pala) /Palatino 0]
  477.   [(Schlbk) /NewCenturySchlbk 0]
  478.   [(Swiss) /Helvetica 0]
  479.   [(Symbol) /Symbol 0]
  480.   [(Times) /Times 0]
  481.     % Substitute for Adobe Multiple Master fonts.
  482.   [(Minion) /Times 0]
  483.   [(Myriad) /Helvetica 0]
  484.     % If the font wants to be monospace, use Courier.
  485.   [(Monospace) /Courier 0]
  486.   [(Typewriter) /Courier 0]
  487.     % Define substitutes for the other Adobe PostScript 3 fonts.
  488.     % For some of them, the substitution is pretty bad!
  489.   [(Albertus) /Palatino 0]
  490.   [(AntiqueOlive) /Helvetica 0]
  491.   [(Bodoni) /NewCenturySchlbk 0]
  492.   [(Chicago) /Helvetica 2]
  493.   [(Clarendon) /Bookman 0]
  494.   [(Cooper) /NewCenturySchlbk 0]
  495.   [(Copperplate) /AvantGarde 0]    % inappropriate, small-cap font
  496.   [(Coronet) /ZapfChancery-MediumItalic 0]
  497.   [(Eurostile) /Helvetica 0]
  498.   [(Geneva) /Courier 2]        % should be fixed-pitch sans demi
  499.   [(GillSans) /Helvetica 2]
  500.   [(GillSans-Light) /Helvetica 0]
  501.   [(Goudy) /Palatino 0]
  502.   [(Hoefler) /NewCenturySchlbk 0]
  503.   [(Joanna) /Times 0]
  504.   [(LetterGothic) /Courier 0]    % should be fixed-pitch sans
  505.   [(LubalinGraph-Book) /Bookman 2]
  506.   [(LubalinGraph-Demi) /Bookman 0]
  507.   [(Marigold) /ZapfChancery-MediumItalic 0]
  508.   [(MonaLisa-Recut) /Palatino 0]    % inappropriate
  509.   [(Monaco) /Courier 2]        % should be fixed-pitch sans demi
  510.   [(Optima) /Helvetica 0]
  511.   [(Oxford) /ZapfChancery-MediumItalic 0]
  512.   [(Tekton) /Helvetica 0]
  513.   [(Univers) /Helvetica 0]
  514. ] readonly def
  515. /.substituteproperties [
  516.   [(It) 9] [(Oblique) 1]
  517.   [(Black) 2] [(Bd) 2] [(Bold) 2] [(bold) 2] [(Demi) 2] [(Heavy) 2] [(Sb) 2]
  518.   [(Cn) 4] [(Cond) 4] [(Narrow) 4] [(Pkg) 4] [(Compr) 4]
  519.   [(Serif) 8] [(Sans) -8]
  520. ] readonly def
  521. /.fontnameproperties {        % <int> <string|name> .fontnameproperties
  522.                 %   <int'>
  523.   .fontnamestring
  524.   .substituteproperties {
  525.     2 copy 0 get search {
  526.       pop pop pop dup length 1 sub 1 exch getinterval 3 -1 roll exch {
  527.     dup 0 ge { or } { neg not and } ifelse
  528.       } forall exch
  529.     } {
  530.       pop pop
  531.     } ifelse
  532.   } forall pop
  533. } bind def
  534. /.substitutefamilies mark
  535.   /AvantGarde
  536.     {/AvantGarde-Book /AvantGarde-BookOblique
  537.      /AvantGarde-Demi /AvantGarde-DemiOblique}
  538.   /Bookman
  539.     {/Bookman-Demi /Bookman-DemiItalic /Bookman-Light /Bookman-LightItalic}
  540.   /Courier
  541.     {/Courier /Courier-Oblique /Courier-Bold /Courier-BoldOblique}
  542.   /Helvetica
  543.     {/Helvetica /Helvetica-Oblique /Helvetica-Bold /Helvetica-BoldOblique
  544.      /Helvetica-Narrow /Helvetica-Narrow-Oblique
  545.      /Helvetica-Narrow-Bold /Helvetica-Narrow-BoldOblique}
  546.   /NewCenturySchlbk
  547.     {/NewCenturySchlbk-Roman /NewCenturySchlbk-Italic
  548.      /NewCenturySchlbk-Bold /NewCenturySchlbk-BoldItalic}
  549.   /Palatino
  550.     {/Palatino-Roman /Palatino-Italic /Palatino-Bold /Palatino-BoldItalic}
  551.   /Symbol
  552.     {/Symbol /Symbol /Symbol /Symbol}
  553.   /Times
  554.     {/Times-Roman /Times-Italic /Times-Bold /Times-BoldItalic}
  555.   /ZapfChancery-MediumItalic
  556.     {/ZapfChancery-MediumItalic}
  557. .dicttomark readonly def
  558. /.nametostring {        % <name> .nametostring <string>
  559.                 % <other> .nametostring <other>
  560.   dup type /nametype eq { .namestring } if
  561. } bind def
  562. /.fontnamestring {        % <fontname> .fontnamestring <string|name>
  563.   dup type dup /nametype eq {
  564.     pop .namestring
  565.   } {
  566.     /stringtype ne { pop () } if
  567.   } ifelse
  568. } bind def
  569. /.substitutefontname {        % <fontname> <properties> .substitutefontname
  570.                 %   <altname|null>
  571.     % Look for properties and/or a face name in the font name.
  572.     % If we find any, use Times (serif) or Helvetica (sans) as the
  573.     % base font; otherwise, use the default font.
  574.     % Note that the "substituted" font name may be the same as
  575.     % the requested one; the caller must check this.
  576.   exch .fontnamestring {
  577.     defaultfontname /Helvetica-Oblique /Helvetica-Bold /Helvetica-BoldOblique
  578.     /Helvetica-Narrow /Helvetica-Narrow-Oblique
  579.     /Helvetica-Narrow-Bold /Helvetica-Narrow-BoldOblique
  580.     /Times-Roman /Times-Italic /Times-Bold /Times-BoldItalic
  581.     /Helvetica-Narrow /Helvetica-Narrow-Oblique
  582.     /Helvetica-Narrow-Bold /Helvetica-Narrow-BoldOblique
  583.   } 3 1 roll
  584.     % Stack: facelist properties fontname
  585.     % Look for a face name.
  586.   .substitutefaces {
  587.     2 copy 0 get search {
  588.       pop pop pop
  589.     % Stack: facelist properties fontname [(pattern) family properties]
  590.       dup 2 get 4 -1 roll or 3 1 roll
  591.       1 get .substitutefamilies exch get
  592.       4 -1 roll pop 3 1 roll
  593.     } {
  594.       pop pop
  595.     } ifelse
  596.   } forall pop
  597.   1 index length mod get exec
  598. } bind def
  599. /.substitutefont {        % <fontname> .substitutefont <altname>
  600.   dup 0 exch .fontnameproperties .substitutefontname
  601.     % Only accept fonts known in the Fontmap.
  602.    Fontmap 1 index known not { pop defaultfontname } if
  603. } bind def
  604.  
  605. % If requested, make (and recognize) fake entries in FontDirectory for fonts
  606. % present in Fontmap but not actually loaded.  Thanks to Ray Johnston for
  607. % the idea behind this code.
  608. FAKEFONTS not { (%END FAKEFONTS) .skipeof } if
  609.  
  610. % We use the presence or absence of the FontMatrix key to indicate whether
  611. % a font is real or fake.  We must pop the arguments at the very end,
  612. % so that stack protection will be effective.
  613.  
  614. /definefont {        % <name> <font> definefont <font>
  615.   dup /FontMatrix known {
  616.     //definefont
  617.   } {
  618.     2 copy /FontName get findfont //definefont exch pop exch pop
  619.   } ifelse
  620. } bind odef
  621.  
  622. /scalefont {        % <font> <scale> scalefont <font>
  623.   1 index /FontMatrix known {
  624.     //scalefont
  625.   } {
  626.     1 index /FontName get findfont 1 index //scalefont
  627.     exch pop exch pop
  628.   } ifelse
  629. } bind odef
  630.  
  631. /makefont {        % <font> <matrix> makefont <font>
  632.   1 index /FontMatrix known {
  633.     //makefont
  634.   } {
  635.     1 index /FontName get findfont 1 index //makefont
  636.     exch pop exch pop
  637.   } ifelse
  638. } bind odef
  639.  
  640. /setfont {        % <font> setfont -
  641.   dup /FontMatrix known {
  642.     //setfont
  643.   } {
  644.     dup /FontName get findfont //setfont pop
  645.   } ifelse
  646. } bind odef
  647.  
  648. %END FAKEFONTS
  649.  
  650. % Define findfont so it tries to load a font if it's not found.
  651. % The Red Book requires that findfont be a procedure, not an operator,
  652. % but it still needs to restore the stacks reliably if it fails,
  653. % so we do all the work in an operator.
  654. /.findfont {
  655.   mark 1 index
  656.   //systemdict begin .dofindfont
  657.     % Define any needed aliases.
  658.   counttomark 1 sub { .aliasfont } repeat end
  659.   exch pop exch pop
  660. } odef
  661. /findfont {
  662.   .findfont
  663. } bind def
  664. % Check whether the font name we are about to look for is already on the list
  665. % of aliases we're accumulating; if so, cause an error.
  666. /.checkalias        % -mark- <alias1> ... <name> .checkalias <<same>>
  667.  { counttomark 1 sub -1 1
  668.     { index 1 index eq
  669.        { pop QUIET not
  670.       { (Unable to substitute for font.) = flush
  671.       } if
  672.      /findfont cvx /invalidfont signalerror
  673.        }
  674.       if
  675.     }
  676.    for
  677.  } bind def
  678. % Get a (non-fake) font if present in a FontDirectory.
  679. /.fontknownget        % <fontdir> <fontname> .fontknownget <font> true
  680.             % <fontdir> <fontname> .fontknownget false
  681.  { .knownget
  682.     { FAKEFONTS
  683.        { dup /FontMatrix known { true } { pop false } ifelse }
  684.        { true }
  685.       ifelse
  686.     }
  687.     { false
  688.     }
  689.    ifelse
  690.  } bind def
  691. % This is the standard procedure for handling font substitution.
  692. % Its location is per an Adobe newsgroup posting.
  693. % It is called with the font name on the stack, standing in for findfont.
  694. /.stdsubstfont {    % mark <alias1> ... <fontname> .stdsubstfont <font>
  695.       /SUBSTFONT where {
  696.     pop QUIET not {
  697.       (Substituting for font ) print dup =only
  698.       (.) = flush
  699.     } if
  700.             % No aliasing.
  701.     cleartomark mark defaultfontname
  702.       } {
  703.     dup .substitutefont
  704.     2 copy eq { pop defaultfontname } if
  705.     .checkalias
  706.     QUIET not {
  707.       SHORTERRORS {
  708.         (%%[) print 1 index =only
  709.         ( not found, substituting ) print dup =only (]%%)
  710.       } {
  711.         (Substituting font ) print dup =only
  712.         ( for ) print 1 index =only (.)
  713.       } ifelse = flush
  714.     } if
  715.             % Remove all the accumulated aliases.
  716.     counttomark 1 add 1 roll cleartomark mark exch
  717.       } ifelse
  718.   .dofindfont
  719. } bind def
  720. $error /SubstituteFont { .stdsubstfont } put
  721. % Scan the next directory on FONTPATH.
  722. /.scannextfontdir {    % - .scannextfontdir <bool>
  723.             % If we haven't scanned all the directories in
  724.             % FONTPATH, scan the next one.
  725.   null 0 1 FONTPATH length 1 sub {
  726.     FONTPATH 1 index get null ne { exch pop exit } if pop
  727.   } for dup null ne {
  728.     dup 0 eq { .scanfontbegin } if
  729.     FONTPATH 1 index get .scanfontdir
  730.     FONTPATH exch null put true
  731.   } {
  732.     pop false
  733.   } ifelse
  734. } bind def
  735. % Do the work of findfont, including substitution, defaulting, and
  736. % scanning of FONTPATH.
  737. /.dofindfont {        % <fontname> .dofindfont <font>
  738.   .tryfindfont not {
  739.             % We didn't find the font.  If we haven't scanned
  740.             % all the directories in FONTPATH, scan the next one
  741.             % now and look for the font again.
  742.     .scannextfontdir {
  743.             % Start over with an empty alias list.
  744.       counttomark 1 sub { pop } repeat
  745.       .dofindfont
  746.     } {
  747.             % No luck.  Make sure we're not already
  748.             % looking for the default font.
  749.       dup defaultfontname eq {
  750.     QUIET not {
  751.       (Unable to load default font ) print
  752.       dup =only (!  Giving up.) = flush
  753.     } if
  754.     /findfont cvx /invalidfont signalerror
  755.       } if
  756.             % Substitute for the font.  Don't alias.
  757.       $error /SubstituteFont get exec
  758.     } ifelse
  759.   } if
  760. } bind def
  761. % Try to find a font using only the present contents of Fontmap.
  762. /.tryfindfont {        % <fontname> .tryfindfont <font> true
  763.             % <fontname> .tryfindfont false
  764.   .FontDirectory 1 index .fontknownget
  765.     {            % Already loaded
  766.       exch pop true
  767.     }
  768.     { dup Fontmap exch .knownget not
  769.        {        % Unknown font name.  Look for a file with the
  770.             % same name as the requested font.
  771.      .tryloadfont
  772.        }
  773.        {        % Try each element of the Fontmap in turn.
  774.      false exch    % (in case we exhaust the list)
  775.             % Stack: fontname false fontmaplist
  776.      { exch pop
  777.        dup type /nametype eq
  778.         {            % Font alias
  779.           .checkalias .tryfindfont exit
  780.         }
  781.         { dup dup type dup /arraytype eq exch /packedarraytype eq or exch xcheck and
  782.            {        % Font with a procedural definition
  783.          exec        % The procedure will load the font.
  784.                 % Check to make sure this really happened.
  785.          .FontDirectory 1 index .knownget
  786.           { exch pop true exit }
  787.          if
  788.            }
  789.            {        % Font file name
  790.          .loadfontloop { true exit } if
  791.            }
  792.           ifelse
  793.         }
  794.        ifelse false
  795.      }
  796.      forall
  797.             % Stack: font true -or- fontname false
  798.      { true
  799.      }
  800.      {            % None of the Fontmap entries worked.
  801.                 % Try loading a file with the same name
  802.                 % as the requested font.
  803.        .tryloadfont
  804.      }
  805.     ifelse
  806.        }
  807.       ifelse
  808.     }
  809.    ifelse
  810.  } bind def
  811.  
  812. % Attempt to load a font from a file.
  813. /.tryloadfont {        % <fontname> .tryloadfont <font> true
  814.             % <fontname> .tryloadfont false
  815.   dup .nametostring
  816.         % Hack: check for the presence of the resource machinery.
  817.   /.genericrfn where {
  818.     pop
  819.     2 copy .fonttempstring /FontResourceDir getsystemparam .genericrfn
  820.     .loadfontloop {
  821.       exch pop exch pop true
  822.     } {
  823.       dup .nametostring .loadfontloop
  824.     } ifelse
  825.   } {
  826.     .loadfontloop
  827.   } ifelse
  828. } bind def
  829. /.loadfontloop {    % <fontname> <filename> .loadfontloop
  830.             %   <font> true
  831.             % -or-
  832.             %   <fontname> false
  833.             % See above regarding the use of 'loop'.
  834.     {             % Is the font name a string?
  835.     dup type /stringtype ne
  836.      { QUIET not
  837.         { (Can't find font with non-string name: ) print dup =only (.) = flush
  838.         }
  839.        if pop false exit
  840.      }
  841.     if
  842.             % Can we open the file?
  843.     findlibfile not
  844.      { QUIET not
  845.         { (Can't find \(or can't open\) font file ) print dup print
  846.           (.) = flush
  847.         }
  848.        if pop false exit
  849.      }
  850.     if
  851.  
  852.             % Stack: fontname fontfilename fontfile
  853.     DISKFONTS
  854.      { .currentglobal true .setglobal
  855.        2 index (r) file
  856.        FontFileDirectory exch 5 index exch .growput
  857.        .setglobal
  858.      }
  859.     if
  860.     QUIET not
  861.      { (Loading ) print 2 index =only
  862.        ( font from ) print 1 index print (... ) print flush
  863.      }
  864.     if
  865.     % If LOCALFONTS isn't set, load the font into local or global
  866.     % VM according to FontType; if LOCALFONTS is set, load the font
  867.     % into the current VM, which is what Adobe printers (but not
  868.     % DPS or CPSI) do.
  869.     LOCALFONTS { false } { /setglobal where } ifelse
  870.      { pop /FontType .findfontvalue { 1 eq } { false } ifelse
  871.         % .setglobal, like setglobal, aliases FontDirectory to
  872.         % GlobalFontDirectory if appropriate.  However, we mustn't
  873.         % allow the current version of .setglobal to be bound in,
  874.         % because it's different depending on language level.
  875.        .currentglobal exch /.setglobal .systemvar exec
  876.         % Remove the fake definition, if any.
  877.        .FontDirectory 3 index .undef
  878.        1 index (r) file .loadfont .FontDirectory exch
  879.        /.setglobal .systemvar exec
  880.      }
  881.      { .loadfont .FontDirectory
  882.      }
  883.     ifelse
  884.         % Stack: fontname fontfilename fontdirectory
  885.     QUIET not
  886.      { //systemdict /level2dict known
  887.         { .currentglobal false .setglobal vmstatus
  888.           true .setglobal vmstatus 3 -1 roll pop
  889.           6 -1 roll .setglobal 5
  890.         }
  891.         { vmstatus 3
  892.         }
  893.        ifelse { =only ( ) print } repeat
  894.        (done.) = flush
  895.      } if
  896.  
  897.         % Check to make sure the font was actually loaded.
  898.     dup 3 index .fontknownget
  899.      { 4 1 roll pop pop pop true exit } if
  900.  
  901.         % Maybe the file had a different FontName.
  902.         % See if we can get a FontName from the file, and if so,
  903.         % whether a font by that name exists now.
  904.     exch (r) file .findfontname
  905.      { 2 copy .fontknownget
  906.         {    % Yes.  Stack: origfontname fontdirectory filefontname fontdict
  907.           3 -1 roll pop exch
  908.           QUIET
  909.            { pop
  910.            }
  911.            { (Using ) print =only
  912.              ( font for ) print 1 index =only
  913.              (.) = flush
  914.            }
  915.           ifelse true exit
  916.         }
  917.        if pop
  918.      }
  919.     if pop
  920.  
  921.         % The font definitely did not load correctly.
  922.     QUIET not
  923.      { (Loading ) print dup =only
  924.        ( font failed.) = flush
  925.      } if
  926.     false exit
  927.  
  928.     } loop        % end of loop
  929.  
  930.  } bind def
  931.  
  932. % Define a procedure to load all known fonts.
  933. % This isn't likely to be very useful.
  934. /loadallfonts
  935.  { Fontmap { pop findfont pop } forall
  936.  } bind def
  937.  
  938. % If requested, load all the fonts defined in the Fontmap into FontDirectory
  939. % as "fake" fonts i.e., font dicts with only FontName and FontType defined.
  940. % (We define FontType only for the sake of some questionable code in the
  941. % Apple Printer Utility 2.0 font inquiry code.)
  942. %
  943. % Note that this procedure only creates fake fonts in the FontDirectory
  944. % associated with the current VM.  This is because in multi-context systems,
  945. % creating the fake fonts in local VM leads to undesirable complications.
  946. /.definefakefonts
  947.     {
  948.     }
  949.     {
  950.       (gs_fonts FAKEFONTS) VMDEBUG
  951.       Fontmap {
  952.     pop dup type /stringtype eq { cvn } if
  953.     .FontDirectory 1 index known not {
  954.       2 dict dup /FontName 3 index put
  955.       dup /FontType 1 put
  956.       .FontDirectory 3 1 roll put
  957.     } {
  958.       pop
  959.     } ifelse
  960.       } forall
  961.     }
  962. FAKEFONTS { exch } if pop def    % don't bind, .current/setglobal get redefined
  963.  
  964. % Install initial fonts from Fontmap.
  965. /.loadinitialfonts
  966.  { NOFONTMAP not
  967.     { /FONTMAP where
  968.       { pop [ FONTMAP .pathlist ]
  969.          { dup VMDEBUG findlibfile
  970.         { exch pop .loadFontmap }
  971.         { /undefinedfilename signalerror }
  972.            ifelse
  973.          }
  974.       }
  975.       { LIBPATH
  976.          { defaultfontmap 1 index .filenamedirseparator
  977.            exch concatstrings concatstrings dup VMDEBUG
  978.            (r) { file } .internalstopped
  979.         { pop pop } { .loadFontmap } ifelse
  980.          }
  981.       }
  982.      ifelse forall
  983.     }
  984.    if
  985.    .definefakefonts    % current VM is global
  986.  } def            % don't bind, .current/setglobal get redefined
  987.  
  988. % ---------------- Synthetic font support ---------------- %
  989.  
  990. % Create a new font by modifying an existing one.  paramdict contains
  991. % entries with the same keys as the ones found in a Type 1 font;
  992. % it should also contain enough empty entries to allow adding the
  993. % corresponding non-overridden entries from the original font dictionary,
  994. % including FID.  If paramdict includes a FontInfo entry, this will
  995. % also override the original font's FontInfo, entry by entry;
  996. % again, it must contain enough empty entries.
  997.  
  998. % Note that this procedure does not perform a definefont.
  999.  
  1000. /.makemodifiedfont    % <fontdict> <paramdict> .makemodifiedfont <fontdict'>
  1001.  { exch
  1002.     {            % Stack: destdict key value
  1003.       1 index /FID ne
  1004.        { 2 index 2 index known
  1005.       {        % Skip fontdict entry supplied in paramdict, but
  1006.             % handle FontInfo specially.
  1007.         1 index /FontInfo eq
  1008.          { 2 index 2 index get        % new FontInfo
  1009.            1 index                % old FontInfo
  1010.         {    % Stack: destdict key value destinfo key value
  1011.           2 index 2 index known
  1012.            { pop pop }
  1013.            { 2 index 3 1 roll put }
  1014.           ifelse
  1015.         }
  1016.            forall pop
  1017.          }
  1018.         if
  1019.       }
  1020.       {        % No override, copy the fontdict entry.
  1021.         2 index 3 1 roll put
  1022.         dup dup    % to match pop pop below
  1023.       }
  1024.      ifelse
  1025.        }
  1026.       if
  1027.       pop pop
  1028.     } forall
  1029.  } bind def
  1030.  
  1031. % Make a modified font and define it.  Note that unlike definefont,
  1032. % this does not leave the font on the operand stack.
  1033.  
  1034. /.definemodifiedfont    % <fontdict> <paramdict> .definemodifiedfont -
  1035.  { .makemodifiedfont
  1036.    dup /FontName get exch definefont pop
  1037.  } bind def
  1038.